home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / asm68k.arc / ASM68KSU.FOR < prev    next >
Text File  |  1985-11-08  |  4KB  |  197 lines
  1. C
  2. C    .TITLE    MC68000 CROSS ASSEMBLER SUPPORT
  3. C
  4. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  5. C
  6. C ASSEMBLY LANGUAGE SUBROUTINES FOR MC68000 CROSS-ASSEMBLER.
  7. C FORTRAN LINKAGE TO THESE ROUTINES IS AS FOLLOWS:
  8. C    1. RETURN VIA 'RTS PC'.
  9. C    2. R5 POINTS TO PARAMETER LIST WITH FOLLOWING:
  10. C        A. NUMBER OF PARAMETERS.
  11. C        B. ADDRESS OF FIRST PARAMETER
  12. C        C. ADDRESS OF SECOND PARAMETER, ETC.
  13. C    3. FUNCTION SUBROUTINES (INTEGER) RETURN VALUE IN R0.
  14. C
  15. C ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  16. C
  17. C ** I4CLR **
  18. C
  19. C CLEAR LOW AND HIGH WORDS OF DOUBLE PRECISION VARIABLE
  20. C ADR OF LOW WORD PASSED VIA (R5)
  21. C
  22.     subroutine i4clr(value)
  23.     implicit integer(a-z)
  24.     value=0
  25.     return
  26.     end
  27. C
  28. C ** GETBIT **
  29. C
  30. C SUBROUTINE TO CONVERT 4 LSB OF A INTEGER*2 VARIABLE TO A HEX
  31. C ASCII DIGIT.  THE INTEGER IS IN THE FIRST PARAMETER AND THE
  32. C HEX DIGIT IS RETURNED IN THE SECOND PARAMETER (BYTE).  THE
  33. C INTEGER IS SHIFTED RIGHT BY 4 BEFORE RETURNING.
  34. C
  35.     subroutine getbit( i2val , bytval )
  36.     implicit integer(a-z)
  37.     integer*2 i2val,tval,hmask,lmask
  38.     byte bytval,tbyt(2)
  39.     equivalence ( tval , tbyt(1) )
  40.     data hmask,lmask/'F000'x,'000F'x/
  41.     tval=i2val
  42.     tval=iiand(tval,lmask)
  43.     bytval=tbyt(1)+48
  44.     if(bytval.gt.57)bytval=bytval+7
  45.     tval=i2val
  46.     i2val=iishft(i2val,-4)
  47.     if(tval.lt.0)i2val=iior(i2val,hmask)
  48.     return
  49.     end
  50. C
  51. C ** ICKVAL **
  52. C
  53. C INTEGER FUNCTION TO CHK IF I*2 VARIABLE IS IN THE RANGE
  54. C -64,63. IF IT IS A VALUE OF 0 IS RETURNED, OTHERWISE
  55. C A VALUE OF ONE IS RETURNED
  56. C
  57.     integer function ickval( i2val )
  58.     implicit integer (a-z)
  59.     integer*2 i2val
  60.     ickval=0
  61.     if((i2val.lt.-64).or.(i2val.gt.63))ickval=1
  62.     return
  63.     end
  64. C
  65. C    THE FOLLOWING INTEGER*4 ARITHMETIC ROUTINES ARE USED INSTEAD
  66. C    OF F4P CALLS TO PERMIT THE CROSS ASSEMBLER TO RUN WITHOUT
  67. C    MODIFICATIONS ON EITHER RT-11 OR RSX-11 SYSTEMS
  68. C
  69.     integer function jadd( op1 , op2 , result )
  70.     implicit integer (a-z)
  71.     result=op1+op2
  72.     jadd=0
  73.     return
  74.     end
  75. C
  76. C    INTEGER*4 SUBTRACTION
  77. C
  78.     integer function jsub( op1 , op2 , result )
  79.     implicit integer (a-z)
  80.     result=op1-op2
  81.     jsub=0
  82.     return
  83.     end
  84. C
  85. C    INTEGER*4 MULTIPLICATION
  86. C
  87.     integer function jmul( op1 , op2 , result )
  88.     implicit integer (a-z)
  89.     result=op1*op2
  90.     jmul=0
  91.     return
  92.     end
  93. C
  94. C    INTEGER*4 DIVISION
  95. C
  96.     integer function jdiv ( op1 , op2 , result )
  97.     implicit integer (a-z)
  98.     result=op1/op2
  99.     jdiv=0
  100.     return
  101.     end
  102. C
  103. C    INTEGER*4 LOGICAL AND
  104. C
  105.     integer function jand ( op1 , op2 , result )
  106.     implicit integer (a-z)
  107.     result=jiand(op1,op2)
  108.     jand=0
  109.     return
  110.     end
  111. C
  112. C    INTEGER*4 INCLUSIVE OR
  113. C
  114.     integer function jor ( op1 , op2 , result )
  115.     implicit integer (a-z)
  116.     result=jior(op1,op2)
  117.     jor=0
  118.     return
  119.     end
  120. C
  121. C ** JLSHF **
  122. C
  123. C    INTEGER*4 LEFT SHIFT (UNSIGNED)
  124. C
  125.     integer function jlshf ( op1 , op2 , result )
  126.     implicit integer (a-z)
  127.     result=jishft(op1,op2)
  128.     jlshf=0
  129.     return
  130.     end
  131. C
  132. C ** JRSHF **
  133. C
  134. C    INTEGER*4 RIGHT SHIFT (UNSIGNED)
  135. C
  136.     integer function jrshf ( op1 , op2 , result )
  137.     implicit integer (a-z)
  138.     result=jishft(op1,-op2)
  139.     jrshf=0
  140.     return
  141.     end
  142. C
  143. C ** JICMP **
  144. C
  145. C    COMPARE A 32 BIT SIGNED NUMBER WITH A 16 BIT SIGNED NUMBER
  146. C    FUNCTION RETURNS A VALUE OF ZERO IF THE NUMBERS ARE EQUIVALENT
  147. C
  148.     integer function jicmp ( i4val , i2val )
  149.     implicit integer (a-z)
  150.     integer*2 i2val
  151.     jicmp=1
  152.     if(i4val.eq.i2val)jicmp=0
  153.     return
  154.     end
  155. C
  156. C ** JMOV **
  157. C
  158. C    INTEGER*4 MOVE
  159. C
  160.     subroutine jmov ( val1 , val2 )
  161.     implicit integer (a-z)
  162.     val2=val1
  163.     return
  164.     end
  165. C
  166. C ** BLDMAP (DLIST,ALIST,OUTPUT) **
  167. C
  168. C    CREATE A REGISTER BITMAP FROM A DATA AND ADR REG MAP
  169. C
  170.     subroutine bldmap ( val1 , val2 , result )
  171.     implicit integer (a-z)
  172.     integer*2 val1,val2,tmp1,tmp2,result
  173.     byte btmp1(2),btmp2(2)
  174.     equivalence ( tmp1,btmp1(1) ) , ( tmp2,btmp2(1) )
  175.     tmp1=val1
  176.     tmp2=val2
  177.     btmp1(2)=btmp2(1)
  178.     result=tmp1
  179.     return
  180.     end
  181. C
  182. C ** JICVT (I*2,I*4 RESULT) **
  183. C
  184. C    I*2 TO I*4 CONVERSION (SIGNED)
  185. C
  186.     integer function jicvt ( i2val , i4val )
  187.     implicit integer (a-z)
  188.     integer*2 i2val
  189.     i4val=i2val
  190.     jicvt=0
  191.     return
  192.     end
  193. c
  194. c
  195. c
  196. c
  197.